Split translation into child packages.

1 files changed, 318 insertions, 0 deletions

diff --git a/src/vhdl/translate/trans-helpers2.adb b/src/vhdl/translate/trans-helpers2.adb
new file mode 100644
index 0000000..cf61883
--- /dev/null
+++ b/src/vhdl/translate/trans-helpers2.adb
@@ -0,0 +1,318 @@
+--  Iir to ortho translator.
+--  Copyright (C) 2002 - 2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Name_Table;
+with Trans.Chap3;
+with Trans.Chap6;
+with Trans_Decls; use Trans_Decls;
+with Files_Map;
+with Trans.Foreach_Non_Composite;
+
+package body Trans.Helpers2 is
+   use Trans.Helpers;
+
+   procedure Copy_Fat_Pointer (D : Mnode; S: Mnode)
+   is
+   begin
+      New_Assign_Stmt (M2Lp (Chap3.Get_Array_Base (D)),
+                       M2Addr (Chap3.Get_Array_Base (S)));
+      New_Assign_Stmt (M2Lp (Chap3.Get_Array_Bounds (D)),
+                       M2Addr (Chap3.Get_Array_Bounds (S)));
+   end Copy_Fat_Pointer;
+
+   --  Convert NAME into a STRING_CST.
+   --  Append a NUL terminator (to make interfaces with C easier).
+   function Create_String_Type (Str : String) return O_Tnode is
+   begin
+      return New_Constrained_Array_Type
+        (Chararray_Type,
+         New_Unsigned_Literal (Ghdl_Index_Type,
+           Unsigned_64 (Str'Length + 1)));
+   end Create_String_Type;
+
+   procedure Create_String_Value
+     (Const : in out O_Dnode; Const_Type : O_Tnode; Str : String)
+   is
+      Res  : O_Cnode;
+      List : O_Array_Aggr_List;
+   begin
+      Start_Const_Value (Const);
+      Start_Array_Aggr (List, Const_Type);
+      for I in Str'Range loop
+         New_Array_Aggr_El
+           (List,
+            New_Unsigned_Literal (Char_Type_Node, Character'Pos (Str (I))));
+      end loop;
+      New_Array_Aggr_El (List, New_Unsigned_Literal (Char_Type_Node, 0));
+      Finish_Array_Aggr (List, Res);
+      Finish_Const_Value (Const, Res);
+   end Create_String_Value;
+
+   function Create_String (Str : String; Id : O_Ident) return O_Dnode
+   is
+      Atype : O_Tnode;
+      Const : O_Dnode;
+   begin
+      Atype := Create_String_Type (Str);
+      New_Const_Decl (Const, Id, O_Storage_Private, Atype);
+      Create_String_Value (Const, Atype, Str);
+      return Const;
+   end Create_String;
+
+   function Create_String (Str : String; Id : O_Ident; Storage : O_Storage)
+                              return O_Dnode
+   is
+      Atype : O_Tnode;
+      Const : O_Dnode;
+   begin
+      Atype := Create_String_Type (Str);
+      New_Const_Decl (Const, Id, Storage, Atype);
+      if Storage /= O_Storage_External then
+         Create_String_Value (Const, Atype, Str);
+      end if;
+      return Const;
+   end Create_String;
+
+   function Create_String (Str : Name_Id; Id : O_Ident; Storage : O_Storage)
+                              return O_Dnode
+   is
+      use Name_Table;
+   begin
+      if Name_Table.Is_Character (Str) then
+         raise Internal_Error;
+      end if;
+      Image (Str);
+      return Create_String (Name_Buffer (1 .. Name_Length), Id, Storage);
+   end Create_String;
+
+   function Create_String_Len (Str : String; Id : O_Ident) return O_Cnode
+   is
+      Str_Cst : O_Dnode;
+      Str_Len : O_Cnode;
+      List    : O_Record_Aggr_List;
+      Res     : O_Cnode;
+   begin
+      Str_Cst := Create_String (Str, Id);
+      Str_Len := New_Unsigned_Literal (Ghdl_Index_Type,
+                                       Unsigned_64 (Str'Length));
+      Start_Record_Aggr (List, Ghdl_Str_Len_Type_Node);
+      New_Record_Aggr_El (List, Str_Len);
+      New_Record_Aggr_El (List, New_Global_Address (Str_Cst,
+                          Char_Ptr_Type));
+      Finish_Record_Aggr (List, Res);
+      return Res;
+   end Create_String_Len;
+
+   procedure Gen_Memcpy (Dest : O_Enode; Src : O_Enode; Length : O_Enode)
+   is
+      Constr : O_Assoc_List;
+   begin
+      Start_Association (Constr, Ghdl_Memcpy);
+      New_Association (Constr, New_Convert_Ov (Dest, Ghdl_Ptr_Type));
+      New_Association (Constr, New_Convert_Ov (Src, Ghdl_Ptr_Type));
+      New_Association (Constr, Length);
+      New_Procedure_Call (Constr);
+   end Gen_Memcpy;
+
+   --  function Gen_Malloc (Length : O_Enode; Ptype : O_Tnode) return O_Enode
+   --  is
+   --     Constr : O_Assoc_List;
+   --  begin
+   --     Start_Association (Constr, Ghdl_Malloc);
+   --     New_Association (Constr, Length);
+   --     return New_Convert_Ov (New_Function_Call (Constr), Ptype);
+   --  end Gen_Malloc;
+
+   function Gen_Alloc
+     (Kind : Allocation_Kind; Size : O_Enode; Ptype : O_Tnode)
+         return O_Enode
+   is
+      Constr : O_Assoc_List;
+   begin
+      case Kind is
+         when Alloc_Heap =>
+            Start_Association (Constr, Ghdl_Malloc);
+            New_Association (Constr, Size);
+            return New_Convert_Ov (New_Function_Call (Constr), Ptype);
+         when Alloc_System =>
+            Start_Association (Constr, Ghdl_Malloc0);
+            New_Association (Constr, Size);
+            return New_Convert_Ov (New_Function_Call (Constr), Ptype);
+         when Alloc_Stack =>
+            return New_Alloca (Ptype, Size);
+         when Alloc_Return =>
+            Start_Association (Constr, Ghdl_Stack2_Allocate);
+            New_Association (Constr, Size);
+            return New_Convert_Ov (New_Function_Call (Constr), Ptype);
+      end case;
+   end Gen_Alloc;
+
+   procedure Register_Non_Composite_Signal (Targ      : Mnode;
+                                            Targ_Type : Iir;
+                                            Proc      : O_Dnode)
+   is
+      pragma Unreferenced (Targ_Type);
+      Constr : O_Assoc_List;
+   begin
+      Start_Association (Constr, Proc);
+      New_Association
+        (Constr, New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr));
+      New_Procedure_Call (Constr);
+   end Register_Non_Composite_Signal;
+
+   function Register_Update_Data_Array
+     (Data : O_Dnode; Targ_Type : Iir; Index : O_Dnode)
+         return O_Dnode
+   is
+      pragma Unreferenced (Targ_Type);
+      pragma Unreferenced (Index);
+   begin
+      return Data;
+   end Register_Update_Data_Array;
+
+   function Register_Prepare_Data_Composite (Targ      : Mnode;
+                                             Targ_Type : Iir;
+                                             Data      : O_Dnode)
+                                                return O_Dnode
+   is
+      pragma Unreferenced (Targ);
+      pragma Unreferenced (Targ_Type);
+   begin
+      return Data;
+   end Register_Prepare_Data_Composite;
+
+   function Register_Update_Data_Record
+     (Data : O_Dnode; Targ_Type : Iir; El : Iir_Element_Declaration)
+         return O_Dnode
+   is
+      pragma Unreferenced (Targ_Type);
+      pragma Unreferenced (El);
+   begin
+      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);
+
+   procedure Register_Signal (Targ      : Mnode;
+                              Targ_Type : Iir;
+                              Proc      : O_Dnode)
+                                 renames Register_Signal_1;
+
+   procedure Register_Signal_List (List : Iir_List; Proc : O_Dnode)
+   is
+      El  : Iir;
+      Sig : Mnode;
+   begin
+      if List = Null_Iir_List then
+         return;
+      end if;
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         Open_Temp;
+         Sig := Chap6.Translate_Name (El);
+         Register_Signal (Sig, Get_Type (El), Proc);
+         Close_Temp;
+      end loop;
+   end Register_Signal_List;
+
+   function Gen_Oenode_Prepare_Data_Composite
+     (Targ : Mnode; Targ_Type : Iir; Val : O_Enode)
+         return Mnode
+   is
+      pragma Unreferenced (Targ);
+      Res       : Mnode;
+      Type_Info : Type_Info_Acc;
+   begin
+      Type_Info := Get_Info (Targ_Type);
+      Res := E2M (Val, Type_Info, Mode_Value);
+      case Type_Info.Type_Mode is
+         when Type_Mode_Array
+            | Type_Mode_Fat_Array =>
+            Res := Chap3.Get_Array_Base (Res);
+         when Type_Mode_Record =>
+            Res := Stabilize (Res);
+         when others =>
+            --  Not a composite type!
+            raise Internal_Error;
+      end case;
+      return Res;
+   end Gen_Oenode_Prepare_Data_Composite;
+
+   function Gen_Oenode_Update_Data_Array (Val       : Mnode;
+                                          Targ_Type : Iir;
+                                          Index     : O_Dnode)
+                                             return O_Enode
+   is
+   begin
+      return M2E (Chap3.Index_Base (Val, Targ_Type, New_Obj_Value (Index)));
+   end Gen_Oenode_Update_Data_Array;
+
+   function Gen_Oenode_Update_Data_Record
+     (Val : Mnode; Targ_Type : Iir; El : Iir_Element_Declaration)
+         return O_Enode
+   is
+      pragma Unreferenced (Targ_Type);
+   begin
+      return M2E (Chap6.Translate_Selected_Element (Val, El));
+   end Gen_Oenode_Update_Data_Record;
+
+   procedure Gen_Oenode_Finish_Data_Composite (Data : in out Mnode)
+   is
+      pragma Unreferenced (Data);
+   begin
+      null;
+   end Gen_Oenode_Finish_Data_Composite;
+
+   function Get_Line_Number (Target: Iir) return Natural
+   is
+      Line, Col: Natural;
+      Name     : Name_Id;
+   begin
+      Files_Map.Location_To_Position
+        (Get_Location (Target), Name, Line, Col);
+      return Line;
+   end Get_Line_Number;
+
+   procedure Assoc_Filename_Line (Assoc : in out O_Assoc_List;
+                                  Line  : Natural) is
+   begin
+      New_Association (Assoc,
+                       New_Lit (New_Global_Address (Current_Filename_Node,
+                         Char_Ptr_Type)));
+      New_Association (Assoc, New_Lit (New_Signed_Literal
+                       (Ghdl_I32_Type, Integer_64 (Line))));
+   end Assoc_Filename_Line;
+end Trans.Helpers2;
+