aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl/translate/trans-chap4.adb
diff options
context:
space:
mode:
Diffstat (limited to 'src/vhdl/translate/trans-chap4.adb')
-rw-r--r--src/vhdl/translate/trans-chap4.adb156
1 files changed, 154 insertions, 2 deletions
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 70f41651b..a33f9ca5b 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -20,12 +20,14 @@ with Errorout; use Errorout;
with Files_Map;
with Iirs_Utils; use Iirs_Utils;
with Std_Package; use Std_Package;
+with Canon;
with Translation; use Translation;
with Trans.Chap2;
with Trans.Chap3;
with Trans.Chap5;
with Trans.Chap6;
with Trans.Chap7;
+with Trans.Chap8;
with Trans.Chap9;
with Trans.Chap14;
with Trans.Rtis;
@@ -462,9 +464,8 @@ package body Trans.Chap4 is
if Type_Info.Type_Mode = Type_Mode_Fat_Array then
-- Allocate.
declare
- Aggr_Type : Iir;
+ Aggr_Type : constant Iir := Get_Type (Value);
begin
- Aggr_Type := Get_Type (Value);
Chap3.Create_Array_Subtype (Aggr_Type);
Name_Node := Stabilize (Name);
New_Assign_Stmt
@@ -2025,6 +2026,157 @@ package body Trans.Chap4 is
end loop;
end Translate_Declaration_Chain;
+ procedure Translate_Statements_Chain_State_Declaration
+ (Stmts : Iir; State_Scope : Var_Scope_Acc)
+ is
+ Num : Nat32;
+ Mark : Id_Mark_Type;
+ Locvar_Id : O_Ident;
+ Els : O_Element_List;
+
+ procedure Push_Prefix (Really_Push : Boolean := True)
+ is
+ Num_Img : String := Nat32'Image (Num);
+ begin
+ Num_Img (Num_Img'First) := 'S';
+ Locvar_Id := Get_Identifier (Num_Img);
+ Num := Num + 1;
+ if Really_Push then
+ Push_Identifier_Prefix (Mark, Num_Img);
+ end if;
+ end Push_Prefix;
+
+ procedure Pop_Prefix (Scope : in out Var_Scope_Type;
+ Really_Push : Boolean := True)
+ is
+ Locvar_Field : O_Fnode;
+ begin
+ if Really_Push then
+ Pop_Identifier_Prefix (Mark);
+ end if;
+
+ New_Union_Field
+ (Els, Locvar_Field, Locvar_Id, Get_Scope_Type (Scope));
+ Set_Scope_Via_Field (Scope, Locvar_Field, State_Scope);
+ end Pop_Prefix;
+
+ Info : Ortho_Info_Acc;
+ Stmt : Iir;
+ Chain : Iir;
+ Scope_Type : O_Tnode;
+ begin
+ Stmt := Stmts;
+
+ Start_Union_Type (Els);
+ Num := 0;
+
+ while Stmt /= Null_Iir loop
+ case Get_Kind (Stmt) is
+ when Iir_Kind_If_Statement =>
+ if Get_Suspend_Flag (Stmt) then
+ Chain := Stmt;
+ while Chain /= Null_Iir loop
+ Push_Prefix;
+
+ Info := Add_Info (Chain, Kind_Locvar_State);
+
+ Translate_Statements_Chain_State_Declaration
+ (Get_Sequential_Statement_Chain (Chain),
+ Info.Locvar_Scope'Access);
+
+ Pop_Prefix (Info.Locvar_Scope);
+
+ Chain := Get_Else_Clause (Chain);
+ end loop;
+ end if;
+
+ when Iir_Kind_Case_Statement =>
+ if Get_Suspend_Flag (Stmt) then
+ Chain := Get_Case_Statement_Alternative_Chain (Stmt);
+ while Chain /= Null_Iir loop
+ if not Get_Same_Alternative_Flag (Chain) then
+ Push_Prefix;
+
+ Info := Add_Info (Chain, Kind_Locvar_State);
+
+ Translate_Statements_Chain_State_Declaration
+ (Get_Associated_Chain (Chain),
+ Info.Locvar_Scope'Access);
+
+ Pop_Prefix (Info.Locvar_Scope);
+ end if;
+ Chain := Get_Chain (Chain);
+ end loop;
+ end if;
+
+ when Iir_Kind_While_Loop_Statement =>
+ if Get_Suspend_Flag (Stmt) then
+ Push_Prefix;
+
+ Info := Add_Info (Stmt, Kind_Loop_State);
+
+ Translate_Statements_Chain_State_Declaration
+ (Get_Sequential_Statement_Chain (Stmt),
+ Info.Loop_Locvar_Scope'Access);
+
+ Pop_Prefix (Info.Loop_Locvar_Scope);
+ end if;
+
+ when Iir_Kind_For_Loop_Statement =>
+ if Get_Suspend_Flag (Stmt) then
+ Push_Prefix;
+
+ Info := Add_Info (Stmt, Kind_Loop_State);
+
+ Push_Instance_Factory (Info.Loop_State_Scope'Access);
+
+ Chap8.Translate_For_Loop_Statement_Declaration (Stmt);
+
+ Translate_Statements_Chain_State_Declaration
+ (Get_Sequential_Statement_Chain (Stmt),
+ Info.Loop_Locvar_Scope'Access);
+
+ Add_Scope_Field (Wki_Locvars, Info.Loop_Locvar_Scope);
+
+ Pop_Instance_Factory (Info.Loop_State_Scope'Access);
+
+ New_Type_Decl (Create_Identifier ("FORTYPE"),
+ Get_Scope_Type (Info.Loop_State_Scope));
+
+ Pop_Prefix (Info.Loop_State_Scope);
+ end if;
+
+ when Iir_Kind_Procedure_Call_Statement =>
+ declare
+ Call : constant Iir := Get_Procedure_Call (Stmt);
+ Imp : constant Iir := Get_Implementation (Call);
+ begin
+ Canon.Canon_Subprogram_Call (Call);
+ Update_Node_Infos;
+
+ if Get_Suspend_Flag (Imp) then
+ Push_Prefix;
+
+ Info := Add_Info (Call, Kind_Call);
+
+ Chap8.Translate_Procedure_Call_State (Call);
+
+ Pop_Prefix (Info.Call_State_Scope);
+ end if;
+ end;
+ when others =>
+ null;
+ end case;
+ Stmt := Get_Chain (Stmt);
+ end loop;
+
+ Finish_Union_Type (Els, Scope_Type);
+
+ New_Type_Decl
+ (Create_Identifier ("LOCVARTYPE"), Scope_Type);
+ Create_Union_Scope (State_Scope.all, Scope_Type);
+ end Translate_Statements_Chain_State_Declaration;
+
procedure Translate_Declaration_Chain_Subprograms (Parent : Iir)
is
El : Iir;